home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / programs.arc / DIFF.PRO < prev    next >
Encoding:
Prolog Source  |  1986-10-07  |  8.6 KB  |  368 lines
  1. /* SYMBOLIC DIFFERENTIATION EXAMPLE */
  2.  
  3. DOMAINS
  4. /*
  5.   The input string is converted to a list of
  6.   tokens
  7. */
  8.  
  9. TOKL = STRING*
  10.  
  11. /*
  12.   Expressions are modeled via EXP
  13. */
  14. EXP=var(STRING);
  15.     int(INTEGER);
  16.     plus(EXP,EXP);
  17.     minus(EXP,EXP);
  18.     mult(EXP,EXP);
  19.     div(EXP,EXP);
  20.     ln(EXP);
  21.     potens(EXP,EXP)
  22.  
  23. PREDICATES
  24.     run
  25.     diff
  26.     d(EXP,STRING,EXP);
  27.     readexp(EXP);
  28.     checkhelp(char)
  29.     check(EXP,TOKL);
  30.  
  31.     writeexp(EXP);
  32.     writePOTENS(EXP);
  33.     writeMULT(EXP);
  34.     writeMINUS(EXP);
  35.     writeDIV(EXP);
  36.     writePAR(EXP);
  37.  
  38.     tokl(STRING,TOKL);      /* Scanner */
  39.     front(STRING,TOKL,TOKL);
  40.  
  41.     s_exp(TOKL,TOKL,EXP);   /* Parser */
  42.     potensexp(TOKL,TOKL,EXP);
  43.     potensexp1(TOKL,TOKL,EXP,EXP);
  44.     multexp(TOKL,TOKL,EXP);
  45.     multexp1(TOKL,TOKL,EXP,EXP);
  46.     plusexp(TOKL,TOKL,EXP);
  47.     plusexp1(TOKL,TOKL,EXP,EXP);
  48.     elmexp(TOKL,TOKL,EXP);
  49.  
  50.     reduce(EXP,EXP);        /* Reducer */
  51.     plusr(EXP,EXP,EXP);
  52.     minusr(EXP,EXP,EXP);
  53.     multr(EXP,EXP,EXP);
  54.     divr(EXP,EXP,EXP);
  55.     lnr(EXP,EXP)
  56.  
  57.     repeat
  58.  
  59. GOAL
  60.     run.
  61.  
  62. CLAUSES
  63.   run:-
  64.       makewindow(1,71,7,"",1,15,9,50),
  65.       write("  S Y M B O L I C  D I F F E R E N T A T I O N"),nl,
  66.       write("  ********************************************"),nl,
  67.       field_attr(0,2,44,112),
  68.       write("        An expression may include: "),nl,
  69.       write("   addition, subtraction, multiplication,\n"),
  70.       write("   division, exponents and logarithms.\n\n"),
  71.       write(" e.g. x+x  or  x*(2+y)^2  or  ln(1+1/(1-x))"),
  72.       makewindow(3,7,7,"",11,3,14,73),
  73.       clearwindow,diff.
  74.  
  75.   diff:-
  76.       readexp(EXP),
  77.       d(EXP,"x",EXP1),
  78.       write("Differentiated expression. :\n"),
  79.       writeexp(EXP1),
  80.       write("\nReduced expression:\n"),
  81.       reduce(EXP1,EXP2),writeexp(EXP2),
  82.       write("\n\nHit any key to continue..."),readchar(_),fail,!.
  83.  
  84.   diff:-diff.
  85.  
  86.   repeat.
  87.   repeat:- repeat.
  88.  
  89. /*
  90.   CLAUSES FOR DIFFERENTIATION
  91. */
  92.  
  93.  
  94.   d(int(_),_,int(0)).
  95.   d(var(X),X,int(1)):-!.
  96.   d(var(_),_,int(0)).
  97.   d(plus(U,V),X,plus(U1,V1)):-
  98.       d(U,X,U1),
  99.       d(V,X,V1).
  100.   d(minus(U,V),X,minus(U1,V1)):-
  101.       d(U,X,U1),
  102.       d(V,X,V1).
  103.   d(mult(U,V),X,plus(mult(U1,V),mult(U,V1))):-
  104.       d(U,X,U1),
  105.       d(V,X,V1).
  106.   d(div(U,V),X,div(minus(mult(U1,V),mult(U,V1)),mult(V,V))):-
  107.       d(U,X,U1),
  108.       d(V,X,V1).
  109.   d(ln(U),X,mult(div(int(1),U),U1)):-d(U,X,U1).
  110.   d(potens(E1,int(I)),_,mult(int(I),potens(E1,int(I1)))):-I1=I-1.
  111.  
  112.  
  113. /*
  114.   CLAUSES FOR READING OF AN EXPRESSION
  115. */
  116.   readexp(EXP) :-
  117.       repeat,
  118.       clearwindow,
  119.       cursor(11,1),
  120.       write("<?> for help     <ESC> to quit"),
  121.       cursor(1,1),
  122.       write("Write an expression: "),
  123.       readchar(Fchar),
  124.       checkhelp(Fchar),
  125.       cursor(1,22),
  126.       write(Fchar),
  127.       readln(STR),!,
  128.       frontchar(STR1,Fchar,STR),
  129.       tokl(STR1,TOKL),
  130.       s_exp(TOKL,OL,EXP),
  131.       check(EXP,OL).
  132.   readexp(int(0)):-exit.
  133.  
  134.   checkhelp('\27'):-exit.
  135.   checkhelp(Fchar):-
  136.       Fchar <> '?',!.
  137.   checkhelp('?'):-
  138.        makewindow(4,23,7,"",10,3,14,73),
  139.        file_str("diff.hlp",I),
  140.        display(I),
  141.        removewindow,
  142.        fail.
  143.  
  144.   check(_,[]):-!.
  145.   check(EXP,_):-
  146.       writeexp(EXP),
  147.       write("<-syntax error\n"),
  148.       fail.
  149.  
  150.   tokl(STR,[TOK|TOKL]):-
  151.       fronttoken(STR,TOK,STR1),!,
  152.       tokl(STR1,TOKL).
  153.   tokl(_,[]).
  154.  
  155.  
  156. /*
  157.   CLAUSES FOR PARSING OF AN EXPRESSION
  158. */
  159.  
  160.   s_exp(IL,OL,EXP):-plusexp(IL,OL,EXP).
  161.  
  162.   plusexp(IL,OL,EXP2):-
  163.       multexp(IL,OL1,EXP1),
  164.       plusexp1(OL1,OL,EXP1,EXP2).
  165.  
  166.   plusexp1(["+"|IL],OL,EXP1,EXP3):-!,
  167.       multexp(IL,OL1,EXP2),
  168.       plusexp1(OL1,OL,plus(EXP1,EXP2),EXP3).
  169.   plusexp1(["-"|IL],OL,EXP1,EXP3):-!,
  170.       multexp(IL,OL1,EXP2),
  171.       plusexp1(OL1,OL,minus(EXP1,EXP2),EXP3).
  172.   plusexp1(IL,IL,EXP,EXP).
  173.  
  174.   multexp(IL,OL,EXP2):-
  175.       potensexp(IL,OL1,EXP1),
  176.       multexp1(OL1,OL,EXP1,EXP2).
  177.  
  178.   multexp1(["*"|IL],OL,EXP1,EXP3):-!,
  179.       potensexp(IL,OL1,EXP2),
  180.       multexp1(OL1,OL,mult(EXP1,EXP2),EXP3).
  181.   multexp1(["/"|IL],OL,EXP1,EXP3):-!,
  182.       potensexp(IL,OL1,EXP2),
  183.       multexp1(OL1,OL,div(EXP1,EXP2),EXP3).
  184.   multexp1(IL,IL,EXP,EXP).
  185.  
  186.   potensexp(IL,OL,EXP2):-
  187.       elmexp(IL,OL1,EXP1),
  188.       potensexp1(OL1,OL,EXP1,EXP2).
  189.   potensexp1(["^"|IL],OL,EXP1,EXP3):-!,
  190.       elmexp(IL,OL1,EXP2),
  191.       potensexp1(OL1,OL,potens(EXP1,EXP2),EXP3).
  192.   potensexp1(IL,IL,EXP,EXP).
  193.  
  194.   elmexp(["("|IL],OL,EXP):-
  195.       s_exp(IL,OL1,EXP),
  196.       front(")",OL1,OL),!.
  197.   elmexp(["("|IL],OL,EXP):-!,
  198.       s_exp(IL,OL,EXP),
  199.       write("ERROR: unmatched parentheses"),nl,
  200.       write("\n\nHit any key to continue..."),readchar(_),fail,!.
  201.   elmexp(["ln","("|IL],OL,ln(EXP)):-!,
  202.       s_exp(IL,OL1,EXP),
  203.       front(")",OL1,OL).
  204.   elmexp([TALSTR|IL],IL,int(INT)):-str_int(TALSTR,INT),!.
  205.   elmexp([NAME|IL],IL,var(NAME)).
  206.  
  207.   front(TOK,[TOK|L],L).
  208.  
  209. /*
  210.   CLAUSES FOR WRITING OF AN EXPRESSION
  211. */
  212.  
  213.   writeexp(var(NAME)):-write(NAME).
  214.   writeexp(int(INT)) :-
  215.       str_int(INTSTR,INT),
  216.       write(INTSTR).
  217.   writeexp(ln(EXP))  :-
  218.       write("ln"),
  219.       writepar(EXP).
  220.   writeexp(plus(EXP1,EXP2)):-
  221.       writeexp(EXP1),
  222.       write("+"),
  223.       writeexp(EXP2).
  224.   writeexp(minus(EXP1,EXP2)):-
  225.       writeexp(EXP1),
  226.       write("-"),
  227.       writeMINUS(EXP2).
  228.   writeexp(mult(EXP1,EXP2)):-
  229.       writeMINUS(EXP1),
  230.       write("*"),
  231.       writeMINUS(EXP2).
  232.   writeexp(div(EXP1,EXP2)):-
  233.       writeMULT(EXP1),
  234.       write("/"),
  235.       writeDIV(EXP2).
  236.   writeexp(potens(EXP1,EXP2)):-
  237.       writeMULT(EXP1),
  238.       write("^"),
  239.       writePOTENS(EXP2).
  240.  
  241.   writePOTENS(div(X,Y)):-!,writepar(div(X,Y)).
  242.   writePOTENS(X):-writeDIV(X).
  243.  
  244.   writeDIV(mult(X,Y)):-!,writepar(mult(X,Y)).
  245.   writeDIV(X):-writeMULT(X).
  246.  
  247.   writeMULT(minus(X,Y)):- !,writepar(minus(X,Y)).
  248.   writeMULT(X):-writeMINUS(X).
  249.  
  250.   writeMINUS(plus(X,Y)):-!,writepar(plus(X,Y)).
  251.   writeMINUS(X):-writeexp(X).
  252.  
  253.   writePAR(EXP):-
  254.       write("("),
  255.       writeexp(EXP),
  256.       write(")").
  257.  
  258. /*
  259.   CLAUSES FOR REDUCTION OF AN EXPRESSION
  260. */
  261.  
  262.   reduce(plus(X,Y),R):- !,
  263.       reduce(X,X1),
  264.       reduce(Y,Y1),
  265.       plusr(X1,Y1,R).
  266.   reduce(minus(X,Y),R):-!,
  267.       reduce(X,X1),
  268.       reduce(Y,Y1),
  269.       minusr(X1,Y1,R).
  270.   reduce(mult(X,Y),R):-!,
  271.       reduce(X,X1),
  272.       reduce(Y,Y1),
  273.       multr(X1,Y1,R).
  274.   reduce(div(X,Y),R):-!,
  275.       reduce(X,X1),
  276.       reduce(Y,Y1),
  277.       divr(X1,Y1,R).
  278.   reduce(ln(X),R):-!,
  279.       reduce(X,X1),
  280.       lnr(X1,R).
  281.   reduce(potens(E,int(1)),E):-!.
  282.   reduce(R,R).
  283.  
  284. /*
  285.   CLAUSES FOR REDUCTION OF AN ADDITION EXPRESSION
  286. */
  287.  
  288.   plusr(int(0),X,X):-!.
  289.   plusr(X,int(0),X):-!.
  290.   plusr(int(X),int(Y),int(Z)):-!,
  291.       X+Y=Z.
  292.   plusr(X,X,mult(int(2),X)):-!.
  293.   plusr(mult(int(I),X),X,mult(int(I1),X)):-!,
  294.       I+1=I1.
  295.   plusr(X,mult(int(I),X),mult(int(I1),X)):-!,
  296.       I+1=I1.
  297.   plusr(mult(int(I1),X),mult(int(I2),X),mult(int(I3),X)):-!,
  298.       I1+I2=I3.
  299.   plusr(int(I),X,plus(X,int(I))):-!.
  300.   plusr(plus(X,int(I1)),int(I2),plus(X,int(I3))):-!,
  301.       I1+I2=I3.
  302.   plusr(plus(X,int(I1)),plus(Y,int(I2)),plus(R,int(I3))):-!,
  303.       I1+I2=I3,
  304.       plusr(X,Y,R).
  305.   plusr(plus(X,int(I)),Y,plus(R,int(I))):-!,
  306.       plusr(X,Y,R).
  307.   plusr(X,Y,plus(X,Y)).
  308.  
  309. /*
  310.   CLAUSES FOR REDUCTION OF A MINUS EXPRESSION
  311. */
  312.  
  313.   minusr(int(X),int(Y),int(Z)):-!,
  314.       Z=X-Y.
  315.   minusr(X,int(0),X):-!.
  316.   minusr(X,X,int(0)):-!.
  317.   minusr(X,int(I),plus(X,int(I1))):-!,
  318.       I1=-I.
  319.   minusr(X,Y,minus(X,Y)).
  320.  
  321. /*
  322.   CLAUSES FOR REDUCTION OF A MULTIPLICATION EXPRESSION
  323. */
  324.  
  325.   multr(int(X),int(Y),int(Z)):-!,
  326.       X*Y=Z.
  327.   multr(int(0),_,int(0)):-!.
  328.   multr(_,int(0),int(0)):-!.
  329.   multr(int(1),X,X):-!.
  330.   multr(X,int(1),X):-!.
  331.   multr(mult(int(I1),X),int(I2),mult(int(I3),X)):-!,
  332.       I1*I2=I3.
  333.   multr(int(I1),mult(int(I2),X),mult(int(I3),X)):-!,
  334.       I1*I2=I3.
  335.   multr(mult(int(I1),X),mult(int(I2),Y),mult(int(I3),R)):-!,
  336.       I1+I2=I3,
  337.       multr(X,Y,R).
  338.   multr(mult(int(I),X),Y,mult(int(I),R)):-!,
  339.       multr(X,Y,R).
  340.   multr(X,int(I),mult(int(I),X)):-!.
  341.   multr(potens(X,int(I1)),potens(X,int(I2)),potens(X,int(I3))):-!,
  342.       I3=I1+I2.
  343.   multr(X,potens(X,int(I)),potens(X,int(I1))):-!,
  344.       I1=I+1.
  345.   multr(potens(X,int(I)),X,potens(X,int(I1))):-!,
  346.       I1=I+1.
  347.   multr(X,X,potens(X,int(2))):-!.
  348.   multr(X,Y,mult(X,Y)).
  349.  
  350. /*
  351.   CLAUSES FOR REDUCTION OF A DIVISION EXPRESION
  352. */
  353.  
  354.   divr(int(0),_,int(0)):-!.
  355.   divr(_,int(0),var("'endless'")):-!,
  356.       write("division by zero"),nl.
  357.   divr(X,int(1),X):-!.
  358.   divr(X,Y,div(X,Y)).
  359.  
  360. /*
  361.   CLAUSES FOR REDUCTION OF A LOGARITHM EXPRESSION
  362. */
  363.  
  364.   lnr(int(0),var("endless")):-!,
  365.       write("logarithm error"),nl.
  366.   lnr(int(1),int(0)):-!.
  367.   lnr(X,ln(X)).
  368.